home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE13 / EXPERT / EXPTEXP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-16  |  20.3 KB  |  646 lines
  1. { *****************************************************
  2.                HomeGrown's 'Expert' Expert
  3.  
  4.   This expert is designed to create Standard, Form and
  5.   Project experts with or without a Form.
  6.  
  7.   If you choose to generate a form it will produce a
  8.   plain form since it is hard to guess what a given
  9.   expert will need on a form.
  10.  
  11.   In addition, I chose to generate overrides for all
  12.   TIExpert methods even though you will not need them
  13.   all. This was done for simplicity. Remove any
  14.   overrides you don't need for a given expert type.
  15.  
  16.   That being said this expert generator will give you
  17.   a working expert with very little work.
  18.  
  19.   Note: This unit is for Delphi 2.0. Change the
  20.   indicated lines to compile in Delphi 1.0. I couldn't
  21.   use conditional defines since proxies.dcu is
  22.   different in Delphi 2.0.
  23.   
  24.   Enjoy!
  25.  
  26.                   Paul Warren
  27.          HomeGrown Software Development
  28.        (c) 1996 Langley British Columbia.
  29.                 (604) 530-9097
  30.          e-mail:  hg_soft@uniserve.com
  31.     Home page: http://haven.uniserve.com/~hg_soft
  32.   ***************************************************** }
  33.  
  34. unit exptexp;
  35.  
  36. interface
  37.  
  38. uses
  39.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  40.   Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, ExptIntf, ToolIntf;
  41.  
  42. type
  43.   { These are the set of flags which determine the type of expert to create }
  44.   TExpAttr = (eaStandard, eaForm, eaProject, eaCreateForm);
  45.   TExpAttrs = set of TExpAttr;
  46.  
  47.   ThgExpExpert = class(TForm)
  48.     Bevel1: TBevel;
  49.     BitBtn1: TBitBtn;
  50.     BitBtn2: TBitBtn;
  51.     Label1: TLabel;
  52.     BitBtn3: TBitBtn;
  53.     Memo1: TMemo;
  54.     Label4: TLabel;
  55.     Label5: TLabel;
  56.     Memo2: TMemo;
  57.     GroupBox1: TGroupBox;
  58.     cbStandard: TCheckBox;
  59.     cbForm: TCheckBox;
  60.     cbProject: TCheckBox;
  61.     GroupBox2: TGroupBox;
  62.     Label2: TLabel;
  63.     Edit2: TEdit;
  64.     cbMakeForm: TCheckBox;
  65.     Edit1: TEdit;
  66.     procedure StyleClick(Sender: TObject);
  67.     procedure BitBtn2Click(Sender: TObject);
  68.     procedure FormShow(Sender: TObject);
  69.     procedure BitBtn3Click(Sender: TObject);
  70.     procedure BitBtn1Click(Sender: TObject);
  71.     procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  72.     procedure Edit2KeyPress(Sender: TObject; var Key: Char);
  73.   private
  74.     { Private declarations }
  75.     SourceBuffer: PChar;
  76.     Definition: TExpAttrs;
  77.     procedure FmtWrite(Stream: TStream; Fmt: PChar; const Args: array of const);
  78.     function CheckOKToRun: boolean;
  79.     function DoFormCreation(const FormIdent: string): TForm;
  80.     function CreateSource(const UnitIdent, FormIdent: string): TMemoryStream;
  81.     function CreateForm(const FormIdent: string): TMemoryStream;
  82.   public
  83.     { Public declarations }
  84.   end;
  85.  
  86.   ThgExpertExpert = class(TIExpert)
  87.   public
  88.     function GetStyle: TExpertStyle; override;
  89.     function GetIDString: string; override;
  90.     function GetName: string; override;
  91.     function GetComment: string; override;
  92.     function GetGlyph: HBITMAP; override;
  93.     function GetState: TExpertState; override;
  94.     function GetMenuText: string; override;
  95.     procedure Execute; override;
  96.   end;
  97.  
  98. var
  99.   hgExpExpert: ThgExpExpert;
  100.  
  101. procedure Register;
  102.  
  103. implementation
  104.  
  105. uses VirtIntf, IStreams, Proxies;
  106.  
  107. {$R *.DFM}
  108.  
  109. const
  110.   SourceBufferSize = 2048;
  111.  
  112. { FormShow method - populate memo and set defaults }
  113. procedure ThgExpExpert.FormShow(Sender: TObject);
  114. begin
  115.   { load copyright info }
  116.   Memo2.Lines.LoadFromFile('\WINDOWS\CPYRIGHT.TXT');
  117.   { include eaStandard and eaCreateForm in Definition - default }
  118.   Include(Definition, eaStandard);
  119.   Include(Definition, eaCreateForm);
  120. end;
  121.  
  122. { StyleClick method - change the style flags }
  123. procedure ThgExpExpert.StyleClick(Sender: TObject);
  124. begin
  125.   if cbStandard.Checked then Include(Definition, eaStandard)
  126.   else Exclude(Definition, eaStandard);
  127.   if cbForm.Checked then Include(Definition, eaForm)
  128.   else Exclude(Definition, eaForm);
  129.   if cbProject.Checked then Include(Definition, eaProject)
  130.   else Exclude(Definition, eaProject);
  131.   if cbMakeForm.Checked then Include(Definition, eaCreateForm)
  132.   else Exclude(Definition, eaCreateForm);
  133. end;
  134.  
  135. { BitBtn3Click method - display message }
  136. procedure ThgExpExpert.BitBtn3Click(Sender: TObject);
  137. begin
  138.   MessageDlg('This expert, by HomeGrown Software Development, will'#13+
  139.              'create a new expert outline and add comments and'#13+
  140.              'copyright information.', mtInformation, [mbOk], 0);
  141. end;
  142.  
  143. { FmtWrite method - write formatted strings to the SourceBuffer }
  144. procedure ThgExpExpert.FmtWrite(Stream: TStream; Fmt: PChar;
  145.   const Args: array of const);
  146. begin
  147.   if (Stream <> nil) and (SourceBuffer <> nil) then
  148.   begin
  149.     StrLFmt(SourceBuffer, SourceBufferSize, Fmt, Args);
  150.     Stream.Write(SourceBuffer[0], StrLen(SourceBuffer));
  151.   end;
  152. end;
  153.  
  154. { CreateSource method - write the synchronous source to SourceBuffer. }
  155. function ThgExpExpert.CreateSource(const UnitIdent, FormIdent: string): TMemoryStream;
  156. const
  157.   CRLF = #13#10;
  158. var
  159.   i: integer;
  160. begin
  161.   SourceBuffer := StrAlloc(SourceBufferSize);
  162.   try
  163.     Result := TMemoryStream.Create;
  164.     try
  165.       FmtWrite(Result,
  166.         '{ *****************************************************'+CRLF+
  167.         '                       %s Expert'+CRLF+CRLF, [Edit1.Text]);
  168.  
  169.       for i := 0 to Memo1.Lines.Count-1 do
  170.       begin
  171.         FmtWrite(Result, '  %s'+CRLF, [Memo1.Lines[i]]);
  172.       end;
  173.  
  174.       FmtWrite(Result, CRLF, [nil]);
  175.  
  176.       for i := 0 to Memo2.Lines.Count-1 do
  177.       begin
  178.         FmtWrite(Result, '  %s'+CRLF, [Memo2.Lines[i]]);
  179.       end;
  180.  
  181.       FmtWrite(Result,
  182.         '  ***************************************************** }'+CRLF+CRLF+
  183.         'unit %s;'+CRLF+CRLF+
  184.         'interface'+CRLF+CRLF, [UnitIdent]);
  185.  
  186.       FmtWrite(Result,
  187.         'uses'+CRLF+
  188.         '  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,'+CRLF+
  189.         '  Forms, Dialogs, ExptIntf, ToolIntf;'+CRLF+CRLF, [nil]);
  190.  
  191.       { begin the class declaration }
  192.       if eaCreateForm in Definition then
  193.       FmtWrite(Result,
  194.         'type'+CRLF+
  195.         '  T%s = class(TForm)'+CRLF+
  196.         '  end;'+CRLF+CRLF, [FormIdent]);
  197.  
  198.       { Standard Expert }
  199.       if eaStandard in Definition then
  200.       begin
  201.       FmtWrite(Result,
  202.         'type'+CRLF+
  203.         '  T%sStandardExpert = class(TIExpert)'+CRLF+
  204.         '  public'+CRLF+
  205.         '    function GetStyle: TExpertStyle; override;'+CRLF+
  206.         '    function GetIDString: string; override;'+CRLF+
  207.         '    function GetName: string; override;'+CRLF, [Edit1.Text]);
  208.  
  209.       FmtWrite(Result,
  210.         '    function GetComment: string; override;'+CRLF+
  211.         '    function GetGlyph: HICON; override;'+CRLF+  {change HICON to HBITMAP for Delphi 1.0}
  212.         '    function GetState: TExpertState; override;'+CRLF+
  213.         '    function GetMenuText: string; override;'+CRLF, [nil]);
  214.  
  215.       FmtWrite(Result,
  216.         '    procedure Execute; override;'+CRLF+
  217.         '  end;'+CRLF+CRLF, [nil]);
  218.       end;
  219.  
  220.       { Form Expert }
  221.       if eaForm in Definition then
  222.       begin
  223.       FmtWrite(Result,
  224.         'type'+CRLF+
  225.         '  T%sFormExpert = class(TIExpert)'+CRLF+
  226.         '  public'+CRLF+
  227.         '    function GetStyle: TExpertStyle; override;'+CRLF+
  228.         '    function GetIDString: string; override;'+CRLF+
  229.         '    function GetName: string; override;'+CRLF, [Edit1.Text]);
  230.  
  231.       FmtWrite(Result,
  232.         '    function GetComment: string; override;'+CRLF+
  233.         '    function GetGlyph: HICON; override;'+CRLF+  {change HICON to HBITMAP for Delphi 1.0}
  234.         '    function GetState: TExpertState; override;'+CRLF+
  235.         '    function GetMenuText: string; override;'+CRLF, [nil]);
  236.  
  237.       FmtWrite(Result,
  238.         '    procedure Execute; override;'+CRLF+
  239.         '  end;'+CRLF+CRLF, [nil]);
  240.       end;
  241.  
  242.       { Project Expert }
  243.       if eaProject in Definition then
  244.       begin
  245.       FmtWrite(Result,
  246.         'type'+CRLF+
  247.         '  T%sProjectExpert = class(TIExpert)'+CRLF+
  248.         '  public'+CRLF+
  249.         '    function GetStyle: TExpertStyle; override;'+CRLF+
  250.         '    function GetIDString: string; override;'+CRLF+
  251.         '    function GetName: string; override;'+CRLF, [Edit1.Text]);
  252.  
  253.       FmtWrite(Result,
  254.         '    function GetComment: string; override;'+CRLF+
  255.         '    function GetGlyph: HICON; override;'+CRLF+  {change HICON to HBITMAP for Delphi 1.0}
  256.         '    function GetState: TExpertState; override;'+CRLF+
  257.         '    function GetMenuText: string; override;'+CRLF, [nil]);
  258.  
  259.       FmtWrite(Result,
  260.         '    procedure Execute; override;'+CRLF+
  261.         '  end;'+CRLF+CRLF, [nil]);
  262.       end;
  263.  
  264.       FmtWrite(Result,
  265.         'procedure Register;'+CRLF+CRLF, [nil]);
  266.  
  267.       if eaCreateForm in Definition then
  268.       FmtWrite(Result,
  269.         'var' + CRLF +
  270.         '  %s: T%s;'+CRLF+CRLF, [FormIdent, FormIdent]);
  271.  
  272.       FmtWrite(Result,
  273.         'implementation'+CRLF+CRLF, [nil]);
  274.  
  275.       FmtWrite(Result,
  276.         'uses VirtIntf, IStreams;'+CRLF+CRLF+
  277.         '{$R *.DFM}'+CRLF+CRLF+
  278.         'const'+CRLF+
  279.         '  SourceBufferSize = 1024;'+CRLF+CRLF, [nil]);
  280.  
  281.       FmtWrite(Result,
  282.         'procedure Register;'+CRLF+
  283.         'begin'+CRLF, [nil]);
  284.  
  285.       if eaStandard in Definition then
  286.       FmtWrite(Result,
  287.         '  RegisterLibraryExpert(T%sStandardExpert.Create);'+CRLF, [Edit1.Text]);
  288.  
  289.       if eaForm in Definition then
  290.       FmtWrite(Result,
  291.         '  RegisterLibraryExpert(T%sFormExpert.Create);'+CRLF, [Edit1.Text]);
  292.  
  293.       if eaProject in Definition then
  294.       FmtWrite(Result,
  295.         '  RegisterLibraryExpert(T%sProjectExpert.Create);'+CRLF, [Edit1.Text]);
  296.  
  297.       FmtWrite(Result,
  298.         'end;'+CRLF+CRLF, [nil]);
  299.  
  300.       { Standard Expert }
  301.       if eaStandard in Definition then
  302.       begin
  303.       FmtWrite(Result,
  304.         '{ T%sStandardExpert code }'+CRLF+
  305.         'function T%sStandardExpert.GetStyle: TExpertStyle;'+CRLF+
  306.         'begin'+CRLF+
  307.         '  Result := esStandard;'+CRLF+
  308.         'end;'+CRLF+CRLF, [Edit1.Text, Edit1.Text]);
  309.  
  310.       FmtWrite(Result,
  311.         'function T%sStandardExpert.GetIDString: String;'+CRLF+
  312.         'begin'+CRLF+
  313.         '  Result := ''%s.%sStandardExpert'';'+CRLF+
  314.         'end;'+CRLF+CRLF+
  315.         'function T%sStandardExpert.GetComment: String;'+CRLF+
  316.         'begin'+CRLF+
  317.         '  Result := ''''; { not needed for esStandard }'+CRLF+
  318.         'end;'+CRLF+CRLF, [Edit1.Text, Edit2.Text, Edit1.Text, Edit1.Text]);
  319.  
  320.       FmtWrite(Result,
  321.         'function T%sStandardExpert.GetGlyph: HICON;'+CRLF+  {change HICON to HBITMAP for Delphi 1.0}
  322.         'begin'+CRLF+
  323.         '  Result := 0; { not needed for esStandard }'+CRLF+
  324.         'end;'+CRLF+CRLF+
  325.         'function T%sStandardExpert.GetName: String;'+CRLF+
  326.         'begin'+CRLF+
  327.         '  Result := ''%s Generator'''+CRLF+
  328.         'end;'+CRLF+CRLF, [Edit1.Text, Edit1.Text, Edit1.Text]);
  329.  
  330.        FmtWrite(Result,
  331.         'function T%sStandardExpert.GetState: TExpertState;'+CRLF+
  332.         'begin'+CRLF+
  333.         '  Result := [esEnabled]'+CRLF+
  334.         'end;'+CRLF+CRLF+
  335.         'function T%sStandardExpert.GetMenuText: String;'+CRLF+
  336.         'begin'+CRLF+
  337.         '  Result := ''%s Standard Expert...'''+CRLF+
  338.         'end;'+CRLF+CRLF, [Edit1.Text, Edit1.Text, Edit1.Text]);
  339.  
  340.       FmtWrite(Result,
  341.         'procedure T%sStandardExpert.Execute;'+CRLF+
  342.         'begin'+CRLF, [Edit1.Text]);
  343.  
  344.       if eaCreateForm in Definition then
  345.       FmtWrite(Result,
  346.         '  if not Assigned(%s) then'+CRLF+
  347.         '    %s := T%s.Create(Application);'+CRLF+
  348.         '  %s.Show;'+CRLF+
  349.         '  %s.SetFocus'+CRLF,[FormIdent, FormIdent,
  350.           FormIdent, FormIdent, FormIdent]);
  351.  
  352.       FmtWrite(Result,
  353.         'end;'+CRLF+CRLF,[nil]);
  354.       end;
  355.  
  356.       { Form Expert }
  357.       if eaForm in Definition then
  358.       begin
  359.       FmtWrite(Result,
  360.         '{ T%sFormExpert code }'+CRLF+
  361.         'function T%sFormExpert.GetStyle: TExpertStyle;'+CRLF+
  362.         'begin'+CRLF+
  363.         '  Result := esForm;'+CRLF+
  364.         'end;'+CRLF+CRLF, [Edit1.Text, Edit1.Text]);
  365.  
  366.       FmtWrite(Result,
  367.         'function T%sFormExpert.GetIDString: String;'+CRLF+
  368.         'begin'+CRLF+
  369.         '  Result := ''%s.%sFormExpert'';'+CRLF+
  370.         'end;'+CRLF+CRLF+
  371.         'function T%sFormExpert.GetComment: String;'+CRLF+
  372.         'begin'+CRLF+
  373.         '  Result := ''Generated by HomeGrown''''s ''''Expert'''' expert.'';'+CRLF+
  374.         'end;'+CRLF+CRLF, [Edit1.Text, Edit2.Text, Edit1.Text, Edit1.Text]);
  375.  
  376.       FmtWrite(Result,
  377.         'function T%sFormExpert.GetGlyph: HICON;'+CRLF+  {change HICON to HBITMAP for Delphi 1.0}
  378.         'begin'+CRLF+
  379.         '  Result := 0;'+CRLF+
  380.         'end;'+CRLF+CRLF+
  381.         'function T%sFormExpert.GetName: String;'+CRLF+
  382.         'begin'+CRLF+
  383.         '  Result := ''%s Generator'''+CRLF+
  384.         'end;'+CRLF+CRLF, [Edit1.Text, Edit1.Text, Edit1.Text]);
  385.  
  386.        FmtWrite(Result,
  387.         'function T%sFormExpert.GetState: TExpertState;'+CRLF+
  388.         'begin'+CRLF+
  389.         '  Result := [esEnabled]'+CRLF+
  390.         'end;'+CRLF+CRLF+
  391.         'function T%sFormExpert.GetMenuText: String;'+CRLF+
  392.         'begin'+CRLF+
  393.         '  Result := ''%s Form Expert...'''+CRLF+
  394.         'end;'+CRLF+CRLF, [Edit1.Text, Edit1.Text, Edit1.Text]);
  395.  
  396.       FmtWrite(Result,
  397.         'procedure T%sFormExpert.Execute;'+CRLF+
  398.         'begin'+CRLF, [Edit1.Text]);
  399.  
  400.       if eaCreateForm in Definition then
  401.       FmtWrite(Result,
  402.         '  if not Assigned(%s) then'+CRLF+
  403.         '    %s := T%s.Create(Application);'+CRLF+
  404.         '  %s.Show;'+CRLF+
  405.         '  %s.SetFocus'+CRLF,[FormIdent, FormIdent,
  406.           FormIdent, FormIdent, FormIdent]);
  407.  
  408.       FmtWrite(Result,
  409.         'end;'+CRLF+CRLF,[nil]);
  410.       end;
  411.  
  412.       { Project Expert }
  413.       if eaProject in Definition then
  414.       begin
  415.       FmtWrite(Result,
  416.         '{ T%sProjectExpert code }'+CRLF+
  417.         'function T%sProjectExpert.GetStyle: TExpertStyle;'+CRLF+
  418.         'begin'+CRLF+
  419.         '  Result := esProject;'+CRLF+
  420.         'end;'+CRLF+CRLF, [Edit1.Text, Edit1.Text]);
  421.  
  422.       FmtWrite(Result,
  423.         'function T%sProjectExpert.GetIDString: String;'+CRLF+
  424.         'begin'+CRLF+
  425.         '  Result := ''%s.%sProjectExpert'';'+CRLF+
  426.         'end;'+CRLF+CRLF+
  427.         'function T%sProjectExpert.GetComment: String;'+CRLF+
  428.         'begin'+CRLF+
  429.         '  Result := ''Generated by HomeGrown''''s ''''Expert'''' expert.'';'+CRLF+
  430.         'end;'+CRLF+CRLF, [Edit1.Text, Edit2.Text, Edit1.Text, Edit1.Text]);
  431.  
  432.       FmtWrite(Result,
  433.         'function T%sProjectExpert.GetGlyph: HICON;'+CRLF+  {change HICON to HBITMAP for Delphi 1.0}
  434.         'begin'+CRLF+
  435.         '  Result := 0;'+CRLF+
  436.         'end;'+CRLF+CRLF+
  437.         'function T%sProjectExpert.GetName: String;'+CRLF+
  438.         'begin'+CRLF+
  439.         '  Result := ''%s Generator'''+CRLF+
  440.         'end;'+CRLF+CRLF, [Edit1.Text, Edit1.Text, Edit1.Text]);
  441.  
  442.        FmtWrite(Result,
  443.         'function T%sProjectExpert.GetState: TExpertState;'+CRLF+
  444.         'begin'+CRLF+
  445.         '  Result := [esEnabled]'+CRLF+
  446.         'end;'+CRLF+CRLF+
  447.         'function T%sProjectExpert.GetMenuText: String;'+CRLF+
  448.         'begin'+CRLF+
  449.         '  Result := ''%s ProjectExpert...'''+CRLF+
  450.         'end;'+CRLF+CRLF, [Edit1.Text, Edit1.Text, Edit1.Text]);
  451.  
  452.       FmtWrite(Result,
  453.         'procedure T%sProjectExpert.Execute;'+CRLF+
  454.         'begin'+CRLF, [Edit1.Text]);
  455.  
  456.       if eaCreateForm in Definition then
  457.       FmtWrite(Result,
  458.         '  if not Assigned(%s) then'+CRLF+
  459.         '    %s := T%s.Create(Application);'+CRLF+
  460.         '  %s.Show;'+CRLF+
  461.         '  %s.SetFocus'+CRLF,[FormIdent, FormIdent,
  462.           FormIdent, FormIdent, FormIdent]);
  463.  
  464.       FmtWrite(Result,
  465.         'end;'+CRLF+CRLF,[nil]);
  466.       end;
  467.  
  468.       if eaCreateForm in Definition then
  469.       FmtWrite(Result,
  470.         '{ T%s code }'+CRLF+CRLF, [FormIdent]);
  471.  
  472.       FmtWrite(Result,
  473.         'end.', [nil]);
  474.  
  475.       Result.Position := 0;
  476.     except
  477.       Result.Free;
  478.       raise;
  479.     end;
  480.   finally
  481.     StrDispose(SourceBuffer);
  482.   end;
  483. end;
  484.  
  485. { DoFormCreation method - Create the dialog defined by the user }
  486. function ThgExpExpert.DoFormCreation(const FormIdent: string): TForm;
  487. begin
  488.   { remove the comments from the next line to compile in Delphi 1.0 }
  489.   {Result := TProxyForm.CreateAs('T' + FormIdent);}
  490.   { comment out the next 2 lines to compile in Delphi 1.0 }
  491.   Result := TForm.Create(nil);
  492.   Proxies.CreateSubClass(Result, 'T' + FormIdent, TForm);
  493.   with Result do
  494.   begin
  495.     BorderStyle := bsSizeable;
  496.     Width := 400;
  497.     Height := 250;
  498.     Position := poScreenCenter;
  499.     Name := FormIdent;
  500.     Caption := FormIdent;
  501.   end;
  502. end;
  503.  
  504. { CreateForm method - create the form, write it out to disk }
  505. function ThgExpExpert.CreateForm(const FormIdent: string): TMemoryStream;
  506. var
  507.   NewForm: TForm;
  508. begin
  509.   Result := nil;
  510.   NewForm := DoFormCreation(FormIdent);
  511.   try
  512.     Result := TMemoryStream.Create;
  513.     Result.WriteComponentRes(FormIdent, NewForm);
  514.     Result.Position := 0;
  515.   finally
  516.     NewForm.Free;
  517.   end;
  518. end;
  519.  
  520. function ThgExpExpert.CheckOKToRun: boolean;
  521. begin
  522.   if (Edit1.Text <> '') and (Edit2.Text <> '') and
  523.       (cbStandard.Checked or cbForm.Checked or cbProject.Checked) then
  524.     Result := true
  525.   else Result := false;
  526. end;
  527.  
  528. { BitBtn1Click method - This method does the actual generating. Note the
  529.   check for ToolServices <> nil. This guarantees the library is running. }
  530. procedure ThgExpExpert.BitBtn1Click(Sender: TObject);
  531. var
  532.   FileName: TFileName;
  533.   ISourceStream, IFormStream: TIMemoryStream;
  534.   UnitIdent, FormIdent: string;
  535. begin
  536.   if CheckOKToRun then
  537.   begin
  538.     if ToolServices <> nil then { I'm an expert!! }
  539.     begin
  540.       if ToolServices.GetNewModuleName(UnitIdent, FileName) then
  541.       try
  542.         UnitIdent := LowerCase(UnitIdent);
  543.         UnitIdent[1] := Upcase(UnitIdent[1]);
  544.         FormIdent := 'Form' + Copy(UnitIdent, 5, 255);
  545.         if eaCreateForm in Definition then
  546.         begin
  547.           IFormStream := TIMemoryStream.Create(CreateForm(FormIdent));
  548.           { remove or comment out the next line to compile in Delphi 1.0. }
  549.           IFormStream.AddRef;
  550.           ISourceStream := TIMemoryStream.Create(CreateSource(UnitIdent, FormIdent));
  551.         end else
  552.           ISourceStream := TIMemoryStream.Create(CreateSource(UnitIdent, ''));
  553.         try
  554.           { remove or comment out the next line to compile in Delphi 1.0. }
  555.           ISourceStream.AddRef;
  556.           if eaCreateForm in Definition then
  557.             ToolServices.CreateModule(FileName, ISourceStream, IFormStream,
  558.               [cmShowSource, cmShowForm, cmUnNamed, cmMarkModified])
  559.           else
  560.             ToolServices.CreateModule(FileName, ISourceStream, nil,
  561.               [cmShowSource, cmUnNamed, cmMarkModified]);
  562.         finally
  563.           ISourceStream.OwnStream := True;
  564.           ISourceStream.Free;
  565.         end;
  566.         Close;
  567.       finally
  568.         if eaCreateForm in Definition then
  569.         begin
  570.           IFormStream.OwnStream := True;
  571.           IFormStream.Free;
  572.         end;
  573.       end;
  574.     end;
  575.   end;
  576. end;
  577.  
  578. { BitBtn2Click method - close expert }
  579. procedure ThgExpExpert.BitBtn2Click(Sender: TObject);
  580. begin
  581.   Close;
  582. end;
  583.  
  584. procedure ThgExpExpert.Edit1KeyPress(Sender: TObject; var Key: Char);
  585. begin
  586.   if Key = ' ' then Key := '_';
  587. end;
  588.  
  589. procedure ThgExpExpert.Edit2KeyPress(Sender: TObject; var Key: Char);
  590. begin
  591.   if Key = ' ' then Key := '_';
  592. end;
  593.  
  594. { TIExpert override methods }
  595. function ThgExpertExpert.GetStyle: TExpertStyle;
  596. begin
  597.   { it's a standard expert }
  598.   Result := esStandard;
  599. end;
  600.  
  601. function ThgExpertExpert.GetIDString: String;
  602. begin
  603.   { unique ID string }
  604.   Result := 'hgsoft.ExpertExpert';
  605. end;
  606.  
  607. function ThgExpertExpert.GetComment: String;
  608. begin
  609.   Result := ''; { not needed for esStandard }
  610. end;
  611.  
  612. function ThgExpertExpert.GetGlyph: HBITMAP;
  613. begin
  614.   Result := 0; { not needed for esStandard }
  615. end;
  616.  
  617. function ThgExpertExpert.GetName: String;
  618. begin
  619.   Result := 'Expert Generator';
  620. end;
  621.  
  622. function ThgExpertExpert.GetState: TExpertState;
  623. begin
  624.   Result := [esEnabled];
  625. end;
  626.  
  627. function ThgExpertExpert.GetMenuText: String;
  628. begin
  629.   Result := 'E&xpert Expert...';
  630. end;
  631.  
  632. procedure ThgExpertExpert.Execute;
  633. begin
  634.   if not Assigned(hgExpExpert) then
  635.     hgExpExpert := ThgExpExpert.Create(Application);
  636.   hgExpExpert.ShowModal;
  637. end;
  638.  
  639. { register the 'Expert' expert }
  640. procedure Register;
  641. begin
  642.   RegisterLibraryExpert(ThgExpertExpert.Create);
  643. end;
  644.  
  645. end.
  646.